home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / modes / view-less.el.z / view-less.el
Encoding:
Text File  |  1998-05-21  |  14.2 KB  |  401 lines
  1. ;;; view-less.el --- Minor mode for browsing files with keybindings like `less'
  2.  
  3. ;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp.
  4.  
  5. ;; Author: Jonathan Stigelman
  6. ;; Keywords: wp unix
  7.  
  8. ;; This file is part of XEmacs.
  9. ;; 
  10. ;; XEmacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2 of the License, or
  13. ;; (at your option) any later version.
  14. ;; 
  15. ;; XEmacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19. ;; 
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; if not, write to the Free Software
  22. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Synched up with: Not in FSF.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;; This mode is for browsing files without changing them.  Keybindings
  29. ;; similar to those used by the less(1) program are used.
  30. ;;
  31. ;; Originally written for v18 by David Gudeman (gudeman@arizona.edu)
  32. ;; Mods by Bengt Martensson, to closely resemble less (July 1987)
  33. ;;
  34. ;; If you would like all write-protected files to be visited in view-mode, 
  35. ;; then add the following to your .emacs file:
  36. ;;
  37. ;;      (add-hook 'find-file-hooks 'auto-view-mode)
  38.  
  39. ;;; Code:
  40.  
  41. (defvar view-search-string ""
  42.   "Last string searched for with view-search functions.")
  43.  
  44. (defvar view-search-arg 1
  45.   "Argument to last view search.")
  46.  
  47. (defvar view-default-lines 10
  48.   "Default value for the \"d\" and \"u\" commands in view-mode")
  49.  
  50. (defvar view-minor-mode nil
  51.   "Non-nil when view-mode is active.  Call `view-mode' to toggle.")
  52. (make-variable-buffer-local 'view-minor-mode)
  53.  
  54. ;;;###autoload
  55. (defvar view-minor-mode-map
  56.   (let ((map (make-keymap)))
  57.     (set-keymap-name map 'view-minor-mode-map)
  58.     (suppress-keymap map)
  59.     (define-key map "-" 'negative-argument)
  60.     (define-key map " " 'scroll-up)
  61.     (define-key map "f" 'scroll-up)
  62.     (define-key map "b" 'scroll-down)
  63.     (define-key map 'backspace 'scroll-down)
  64.     (define-key map 'delete 'scroll-down)
  65.     (define-key map "\r" 'view-scroll-lines-up)
  66.     (define-key map "\n" 'view-scroll-lines-up)
  67.     (define-key map "e" 'view-scroll-lines-up)
  68.     (define-key map "j" 'view-scroll-lines-up)
  69.     (define-key map "y" 'view-scroll-lines-down)
  70.     (define-key map "k" 'view-scroll-lines-down)
  71.     (define-key map "d" 'view-scroll-some-lines-up)
  72.     (define-key map "u" 'view-scroll-some-lines-down)
  73.     (define-key map "r" 'recenter)
  74.     (define-key map "t" 'toggle-truncate-lines)
  75.     (define-key map "N" 'view-buffer)
  76.     (define-key map "E" 'view-file)
  77.     (define-key map "P" 'view-buffer)
  78.     (define-key map "!" 'shell-command)
  79.     (define-key map "|" 'shell-command-on-region)
  80.     (define-key map "=" 'what-line)
  81.     (define-key map "?" 'view-search-backward)
  82.     (define-key map "h" 'view-mode-describe)
  83.     (define-key map "s" 'view-repeat-search)
  84.     (define-key map "n" 'view-repeat-search)
  85.     (define-key map "/" 'view-search-forward)
  86.     (define-key map "\\" 'view-search-backward)
  87.     (define-key map "g" 'view-goto-line)
  88.     (define-key map "G" 'view-last-windowful)
  89.     (define-key map "%" 'view-goto-percent)
  90.     (define-key map "p" 'view-goto-percent)
  91.     (define-key map "m" 'point-to-register)
  92.     (define-key map "'" 'register-to-point)
  93.     (define-key map "C" 'view-cleanup-backspaces)
  94.     (define-key map "\C-c\C-c" 'view-quit)
  95.     ;; #### - should this use substitute-command-keys?
  96.     (define-key map "\C-x\C-q" 'view-quit-toggle-ro)
  97.     (define-key map "q" 'view-quit)
  98.     map
  99.     ))
  100.  
  101. (add-minor-mode 'view-minor-mode " View" view-minor-mode-map)
  102.  
  103. ;;;###autoload
  104. (defvar view-mode-map
  105.   (let ((map (copy-keymap view-minor-mode-map)))
  106.     (set-keymap-name map 'view-mode-map)
  107.     map))
  108.  
  109. ;;;###autoload
  110. (defun view-file (file &optional other-p)
  111.   "Find FILE, enter view mode.  With prefix arg OTHER-P, use other window."
  112.   (interactive "fView File: \nP")
  113.   (let ((old-p (get-file-buffer file))
  114.     (obuf (current-buffer)))
  115.     (if other-p
  116.     (find-file-other-window file)
  117.       (find-file file))
  118.     (view-mode (if other-p nil obuf)
  119.            (if old-p nil 'kill-buffer))
  120.     nil))
  121.  
  122. ;;;###autoload
  123. (defun view-buffer (buf &optional other-p)
  124.   "Switch to BUF, enter view mode.  With prefix arg use other window."
  125.   (interactive "bView Buffer: \nP")
  126.   (let ((obuf (current-buffer)))
  127.     (if other-p
  128.     (switch-to-buffer-other-window buf)
  129.       (switch-to-buffer buf))
  130.     (view-mode (if other-p nil obuf) (if other-p nil 'bury-buffer))))
  131.  
  132. ;;;###autoload
  133. (defun view-file-other-window (file)
  134.   "Find FILE in other window, and enter view mode."
  135.   (interactive "fView File: ")
  136.   (view-file file t))
  137.  
  138. ;;;###autoload
  139. (defun view-buffer-other-window (buffer)
  140.   "Switch to BUFFER in another window, and enter view mode."
  141.   (interactive "bView Buffer: ")
  142.   (view-buffer buffer t))
  143.  
  144. (defun view-brief-help ()
  145.   (message
  146.    (substitute-command-keys
  147.     "\\<view-minor-mode-map>\\[scroll-up] = page forward; \\[scroll-down] = page back; \
  148. \\[view-mode-describe] = help; \\[view-quit] = quit.")))
  149.  
  150. (defvar view-exit-position)
  151. (defvar view-prev-buffer)
  152. (defvar view-exit-action)
  153. (defvar view-old-buffer-read-only)
  154.  
  155. ;;;###autoload
  156. (defun view-minor-mode (&optional prev-buffer exit-action)
  157.   "Minor mode for viewing text, with bindings like `less'.
  158. Commands are:
  159. \\<view-minor-mode-map>
  160. 0..9    prefix args
  161. -    prefix minus
  162. \\[scroll-up]    page forward
  163. \\[scroll-down]    page back
  164. \\[view-scroll-lines-up]    scroll prefix-arg lines forward, default 1.
  165. \\[view-scroll-lines-down]    scroll prefix-arg lines backward, default 1.
  166. \\[view-scroll-some-lines-down]    scroll prefix-arg lines backward, default 10.
  167. \\[view-scroll-some-lines-up]    scroll prefix-arg lines forward, default 10.
  168. \\[what-line]    print line number
  169. \\[view-mode-describe]    print this help message
  170. \\[view-search-forward]    regexp search, uses previous string if you just hit RET
  171. \\[view-search-backward]    as above but searches backward
  172. \\[view-repeat-search]    repeat last search
  173. \\[view-goto-line]    goto line prefix-arg, default 1
  174. \\[view-last-windowful]    goto line prefix-arg, default last line
  175. \\[view-goto-percent]    goto a position by percentage
  176. \\[toggle-truncate-lines]    toggle truncate-lines
  177. \\[view-file]    view another file
  178. \\[view-buffer]    view another buffer
  179. \\[view-cleanup-backspaces]    cleanup backspace constructions
  180. \\[shell-command]    execute a shell command
  181. \\[shell-command-on-region]\
  182.     execute a shell command with the region as input
  183. \\[view-quit]    exit view-mode, and bury the current buffer.
  184.  
  185. If invoked with the optional (prefix) arg non-nil, view-mode cleans up
  186. backspace constructions.
  187.  
  188. More precisely:
  189. \\{view-minor-mode-map}"
  190.   (interactive)
  191.  
  192.   (make-local-variable 'view-default-lines)
  193.   (set (make-local-variable 'view-exit-position)      (point))
  194.   (set (make-local-variable 'view-prev-buffer)   prev-buffer)
  195.   (set (make-local-variable 'view-exit-action)   exit-action)
  196.   (set (make-local-variable 'view-old-buffer-read-only)     buffer-read-only)
  197.   (add-hook (make-local-variable 'change-major-mode-hook)
  198.         'view-fixup-read-only)
  199.   (setq view-minor-mode  t
  200.     buffer-read-only t)
  201.   (view-brief-help))
  202.  
  203. ;;;###autoload
  204. (defun view-mode (&optional prev-buffer exit-action clean-bs)
  205.   "View the current buffer using view-minor-mode.  This exists to be 99.9%
  206. compatible with the implementations of `view-mode' in view.el and older
  207. versions of view-less.el."
  208.   (interactive (list nil 'bury-buffer current-prefix-arg))
  209.   ;; #### - The first two arguments provide compatibility with view.el (and
  210.   ;; thus FSFmacs), while the third argument as a prefix argument maintains
  211.   ;; interactive compatibility with older versions of view-less.  --Stig
  212.   (if clean-bs (cleanup-backspaces))
  213.   (view-minor-mode prev-buffer exit-action))
  214.  
  215. ;;;###autoload
  216. (defun view-major-mode (&optional prev-buffer exit-action clean-bs)
  217.   "View the current buffer using view-mode, as a major mode.
  218. This function has a nonstandard name because `view-mode' is wrongly
  219. named but is like this for compatibility reasons."
  220.   ;; #### - The first two arguments provide compatibility with view.el (and
  221.   ;; thus FSFmacs), while the third argument as a prefix argument maintains
  222.   ;; interactive compatibility with older versions of view-less.  --Stig
  223.   (interactive (list nil 'bury-buffer current-prefix-arg))
  224.   (kill-all-local-variables)
  225.   (use-local-map view-mode-map)
  226.   (setq major-mode 'view-mode)
  227.   (set (make-local-variable 'view-exit-position)      (point))
  228.   (set (make-local-variable 'view-prev-buffer)   prev-buffer)
  229.   (set (make-local-variable 'view-exit-action)   exit-action)
  230.   (set (make-local-variable 'view-old-buffer-read-only)     buffer-read-only)
  231.   (set (make-local-variable 'view-major-mode) t)
  232.   (setq buffer-read-only t)
  233.   (if clean-bs (cleanup-backspaces))
  234.   (run-hooks 'view-mode-hook))
  235.  
  236. ;;;###autoload
  237. (defun auto-view-mode ()
  238.   "If the file of the current buffer is not writable, call view-mode.
  239. This is meant to be added to `find-file-hooks'."
  240.   (or (file-writable-p buffer-file-name)
  241.       (view-minor-mode)))
  242.  
  243. (defun view-fixup-read-only ()
  244.   ;; doing M-x normal mode should NOT leave the buffer read-only
  245.   (and (boundp 'view-old-buffer-read-only)
  246.        (progn (setq buffer-read-only view-old-buffer-read-only)
  247.           (kill-local-variable 'view-old-buffer-read-only))))
  248.  
  249. (defun view-quit-toggle-ro ()
  250.   "Exit view mode and execute the global binding of the key that invoked this
  251. command.  Normally, this will toggle the state of `buffer-read-only', perhaps
  252. invoking some version-control mechanism."
  253.   (interactive) 
  254.   (setq view-exit-position nil)
  255.   ;; Kludge so this works as advertised.  Stig, why can't you write
  256.   ;; bug-free code???
  257.   (let ((buffer-read-only buffer-read-only))
  258.     (view-quit t))
  259.   ;; no longer in view-minor-mode, so the keymap has changed...
  260.   (call-interactively (key-binding (this-command-keys))))
  261.  
  262. (defun view-quit (&optional no-exit-action)
  263.   "Exit view mode.  With prefix argument, keep the current buffer selected."
  264.   (interactive "P")
  265.   (view-fixup-read-only)
  266.   (setq view-minor-mode nil)
  267.   (if view-exit-position (goto-char view-exit-position))
  268.   (if (and (boundp 'view-major-mode) view-major-mode)
  269.       (fundamental-mode)
  270.     (let ((pbuf view-prev-buffer)
  271.       (exitact view-exit-action))
  272.       (if no-exit-action
  273.       nil
  274.     (if exitact (funcall exitact (current-buffer)))
  275.     (if pbuf (switch-to-buffer pbuf))))))
  276.  
  277. ;; #### - similar to what's in man.el and this ought to be written in C anyway...  --Stig
  278. (defun cleanup-backspaces ()
  279.   "Cleanup backspace constructions.
  280. _^H and ^H_ sequences are deleted.  x^Hx sequences are turned into x for all
  281. characters x.  ^^H| and |^H^ sequences are turned into ^.  +^Ho and o^H+ are
  282. turned into (+)."
  283.   (interactive)
  284.   (save-excursion
  285.     (goto-char (point-min))
  286.     (while (= (following-char) ?\C-h)
  287.       (delete-char 1))
  288.     (while (search-forward "\C-h" nil t)
  289.       (forward-char -2)
  290.       (cond ((looking-at "_\C-h\\|\\(.\\)\C-h\\1\\||\C-h\\^")
  291.          (delete-char 2))
  292.         ((looking-at ".\C-h_\\|\\^\C-h|")
  293.          (forward-char 1)
  294.          (delete-char 2))
  295.         ((looking-at "+\C-ho\\|o\C-h+")
  296.          (delete-char 3)
  297.          (insert "(+)"))
  298.         ((looking-at "|\C-h-")
  299.          (delete-char 3)
  300.          (insert "*"))
  301.         (t (forward-char 2))))))
  302.  
  303. (defun view-cleanup-backspaces ()
  304.   "Cleanup backspaces and if buffer is currently unmodified, don't flag it
  305. as a modified buffer.  This works even if the buffer is read-only."
  306.   (interactive)
  307.   (let ((buffer-read-only)
  308.     (buf-mod (buffer-modified-p)))
  309.     (cleanup-backspaces)
  310.     ;; #### - THIS IS PROBABLY A REALLY DANGEROUS THING TO DO IN A MINOR MODE!!
  311.     (set-buffer-modified-p buf-mod)))
  312.  
  313. (defun toggle-truncate-lines (&optional p)
  314.   "Toggles the values of truncate-lines.
  315. Positive prefix arg sets, negative disables."
  316.   (interactive "P")
  317.   (setq truncate-lines (if p
  318.                (> (prefix-numeric-value p) 0)
  319.              (not truncate-lines)))
  320.   (recenter))
  321.  
  322. (defun view-scroll-lines-up (p)
  323.   "Scroll up prefix-arg lines, default 1."
  324.   (interactive "p")
  325.   (scroll-up p))
  326.  
  327. (defun view-scroll-lines-down (p)
  328.   "Scroll down prefix-arg lines, default 1."
  329.   (interactive "p")
  330.   (scroll-up (- p)))
  331.  
  332. (defun view-scroll-some-lines-down (&optional n)
  333.   "Scroll down prefix-arg lines, default 10, or last argument."
  334.   (interactive "p")
  335.   (if (> n 1) (setq view-default-lines n))
  336.   (scroll-down view-default-lines))
  337.  
  338. (defun view-scroll-some-lines-up (&optional n)
  339.   "Scroll up prefix-arg lines, default 10, or last argument."
  340.   (interactive "p")
  341.   (if (> n 1) (setq view-default-lines n))
  342.   (scroll-up view-default-lines))
  343.  
  344. (defun view-goto-line (&optional n)
  345.   "Goto prefix arg line N.  N = 1 by default.."
  346.   (interactive "p")
  347.   (goto-line n))
  348.  
  349. (defun view-last-windowful (&optional n)
  350.   "Goto prefix arg line N or the first line of the last windowful in buffer."
  351.   (interactive "p")
  352.   (if current-prefix-arg
  353.       (goto-line n)
  354.     (end-of-buffer)
  355.     (recenter -1)
  356.     (move-to-window-line 0)))
  357.  
  358. (defun view-goto-percent (&optional percent)
  359.   "Set mark and go to a position PERCENT way into the current buffer."
  360.   (interactive "p")
  361.   (set-mark-command nil)
  362.   (goto-char (+ (point-min) (/ (* percent (- (point-max) (point-min))) 100)))
  363.   (beginning-of-line))
  364.  
  365. (defun view-mode-describe ()
  366.   (interactive)
  367.   (let ((mode-name "View")
  368.     (major-mode 'view-mode))
  369.     (describe-mode)))
  370.  
  371. (defun view-search-forward (s p)
  372.   "Search forward for REGEXP.  If regexp is empty, use last search string.
  373. With prefix ARG, search forward that many occurrences."
  374.   (interactive "sView search: \np")
  375.   (unwind-protect
  376.       (re-search-forward        
  377.        (if (string-equal "" s) view-search-string s) nil nil p)
  378.     (setq view-search-arg p)
  379.     (or (string-equal "" s)
  380.     (setq view-search-string s))))
  381.  
  382. (defun view-search-backward (s p)
  383.   "Search backward for REGEXP.  If regexp is empty, use last search string.
  384. With prefix ARG, search forward that many occurrences."
  385.   (interactive "sView search backward: \np")
  386.   (view-search-forward s (- p)))
  387.  
  388. (defun view-repeat-search (p)
  389.   "Repeat last view search command.  If a prefix arg is given, use that
  390. instead of the previous arg, if the prefix is just a -, then take the
  391. negative of the last prefix arg."
  392.   (interactive "P")
  393.   (view-search-forward
  394.    view-search-string
  395.    (cond ((null p) view-search-arg)
  396.      ((eq p '-) (- view-search-arg))
  397.      (t (prefix-numeric-value p)))))
  398.  
  399. (provide 'view)
  400. (provide 'view-less)
  401.